home *** CD-ROM | disk | FTP | other *** search
/ PC Plus SuperCD (UK) 1997 May / PC Plus Super CD Issue 127 (May 1997).iso / delphi2 / delphite.exe / data.z / NDXREBU.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1996-08-12  |  4.3 KB  |  163 lines
  1. unit Ndxrebu;
  2.  
  3. interface
  4.  
  5. uses
  6.   SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  7.   Forms, Dialogs, StdCtrls, Buttons, DB, BDE, DBTables, ExtCtrls, ComCtrls;
  8.  
  9. type
  10.   TForm1 = class(TForm)
  11.     cbAlias: TComboBox;
  12.     cbTable: TComboBox;
  13.     Label1: TLabel;
  14.     Label2: TLabel;
  15.     BitBtn1: TBitBtn;
  16.     BitBtn2: TBitBtn;
  17.     tblIndex: TTable;
  18.     StatusBar1: TStatusBar;
  19.     procedure FormCreate(Sender: TObject);
  20.     procedure cbAliasChange(Sender: TObject);
  21.     procedure BitBtn1Click(Sender: TObject);
  22.   public
  23.     function RebuildIndexes(strAlias, strTable: string;
  24.       var strError: string): Boolean;
  25.     procedure HandleExceptions(Sender: TObject; E: Exception);
  26.     procedure WriteMsg(strWrite: string);
  27.   end;
  28.  
  29. var
  30.   Form1: TForm1;
  31.  
  32. implementation
  33.  
  34. {$R *.DFM}
  35.  
  36. procedure TForm1.HandleExceptions(Sender: TObject; E: Exception);
  37. begin
  38.   If E.Message <> '' then
  39.   begin
  40.     Screen.Cursor := crArrow;
  41.     MessageDlg(E.Message, mtError, [mbOK], 0);
  42.   end;
  43. end;
  44.  
  45. procedure TForm1.WriteMsg(strWrite: string);
  46. begin
  47.   StatusBar1.Panels[0].Text := strWrite;
  48.   StatusBar1.Update;
  49. end;
  50.  
  51. function TForm1.RebuildIndexes(strAlias, strTable: string;
  52.   var strError: string): Boolean;
  53. var
  54.    bdeResult: DBIResult;
  55. begin
  56.   Result := False;
  57.   if tblIndex.Active then
  58.     tblIndex.Active := False;
  59.  
  60.   tblIndex.DatabaseName := strAlias;
  61.   tblIndex.TableName := strTable;
  62.  
  63.   Screen.Cursor := crHourglass;
  64.   try
  65.     WriteMsg('Opening ' + strTable + '...');
  66.     tblIndex.Open;
  67.   finally
  68.     Screen.Cursor := crDefault;
  69.   end;
  70.  
  71.   if not tblIndex.Active then
  72.     strError := 'The table could not be opened exclusively.  It is ' +
  73.                 'probably being used by another user or application.'
  74.   else begin
  75.     WriteMsg('Regenerating indexes for ' + strTable + '...');
  76.     Screen.Cursor := crHourglass;
  77.     try
  78.       bdeResult := DbiRegenIndexes(tblIndex.Handle);
  79.       case bdeResult of
  80.         DBIERR_NONE: Result := True;
  81.         DBIERR_INVALIDHNDL: strError := 'Invalid table handle.';
  82.         DBIERR_NEEDEXCLACCESS: strError := 'Table is open in shared mode.';
  83.         DBIERR_NOTSUPPORTED: strError := 'Remote indexes cannot be rebuilt.';
  84.       else
  85.         strError := 'Unexpected Error Returned by BDE.';
  86.       end;
  87.     finally
  88.       Screen.Cursor := crDefault;
  89.     end;
  90.   end;
  91.   WriteMsg( '' );
  92. end;
  93.  
  94. procedure TForm1.FormCreate(Sender: TObject);
  95. begin
  96.   { Set up the exception handler. }
  97.   Application.OnException := HandleExceptions;
  98.    
  99.   { Populate the Alias drop down with the currently
  100.     defined aliases. }
  101.  
  102.   Screen.Cursor := crHourglass;
  103.   try
  104.     Session.GetAliasNames(cbAlias.Items);
  105.     cbAlias.ItemIndex := 0;
  106.   finally
  107.     Screen.Cursor := crDefault;
  108.   end;
  109.  
  110.   { Now, get the table name for the first index in the list. }
  111.   cbAliasChange(nil);
  112. end;
  113.  
  114. procedure TForm1.cbAliasChange(Sender: TObject);
  115. begin
  116.   { Get the tables in the new index. }
  117.   Screen.Cursor := crHourglass;
  118.   try
  119.     with cbAlias do
  120.       Session.GetTableNames(Items[ItemIndex],
  121.         '', TRUE, FALSE, cbTable.Items );
  122.    cbTable.Items.Insert(0, '<All Tables>');
  123.    cbTable.ItemIndex := 0;
  124.   finally
  125.     Screen.Cursor := crDefault;
  126.   end;
  127. end;
  128.  
  129. procedure TForm1.BitBtn1Click(Sender: TObject);
  130. var
  131.   strTable: string;
  132.   Counter: Integer;
  133.   iNTables: Integer;
  134.   strError: string;
  135. begin
  136.   strError := '';
  137.   if cbTable.ItemIndex > 0 then
  138.   begin
  139.     if not RebuildIndexes(cbAlias.Items[cbAlias.ItemIndex],
  140.       cbTable.Items[cbTable.ItemIndex], strError) then
  141.       MessageDlg('Unable to rebuild indexes for ' +
  142.         cbTable.Items[ cbTable.ItemIndex ] +
  143.         '.  Reason: ' +  '. ' + #10 + #10 +
  144.         strError, mtError, [mbOK], 0);
  145.     end
  146.     else begin
  147.       iNTables := cbTable.Items.Count;
  148.       for Counter := 1 to cbTable.Items.Count - 1 do
  149.       begin
  150.         StatusBar1.Panels[1].Text := IntToStr(iNTables - Counter);
  151.         StatusBar1.Update;
  152.         if not RebuildIndexes(cbAlias.Items[cbAlias.ItemIndex],
  153.           cbTable.Items[Counter], strError) then
  154.           MessageDlg('Unable to rebuild indexes for ' +
  155.             cbTable.Items[Counter] + '. ' + #10 + #10 +
  156.             'Reason: ' + strError, mtError, [mbOK], 0 );
  157.       end;
  158.       StatusBar1.Panels[1].Text := '';
  159.       StatusBar1.Update;
  160.     end;
  161.   end;
  162. end.
  163.